Cartographic Tour of R and {ggplot2}

Justin Sherrill

Who am I?

  • Analyst with ECOnorthwest
  • Data visualization, housing & demographic analysis, mapping
  • R maps featured in Upper Left Cities: A Cultural Atlas of San Francisco, Portland, and Seattle

Who am I?

  • Analyst with ECOnorthwest
  • Data visualization, housing & demographic analysis, mapping
  • R maps featured in Upper Left Cities: A Cultural Atlas of San Francisco, Portland, and Seattle

Cartography in R

Keep it in {ggplot2}. Why?

  • Reinforces learning the ins and outs of one of the strongest dataviz tools in existence

  • Flexible enough for the needs of the project and your personal style

  • Good chance of redundancy - many overlapping

  • Meet exciting new developers learn new ways of analysis & visualization

Cartography in R

  • Sometimes you need a custom package to accomplish the task at hand

  • Other times, {sf} and {ggplot2} had the solution all along

What is “good” cartography?

  • Visual hierarchy
  • Legibility
  • Figure-ground
  • Balance
  • Making choices

How to make a good map

  • Copy a good map
  •   Jacques Bertin
  •   William Bunge
  •   Timo Grossenbacher

How to make a good map

  • Copy a good map
  •   Jacques Bertin
  •   William Bunge
  •   Timo Grossenbacher

How to make a good map

  • Copy a good map
  •   Jacques Bertin
  •   William Bunge
  •   Timo Grossenbacher

Marginalia

📎 {ggspatial} can do so much, including easily add a north arrow and scale bar to your map

sea <- places("wa",
              cb = TRUE) %>%
  filter(NAME == "Seattle") %>%
  st_transform(3857) %>%
  erase_water(area_threshold = .25) 

ggplot() +
  geom_sf(data = sea) +
  ggspatial::annotation_north_arrow(location = "br",
                                    which_north = "true",
                                    style = north_arrow_minimal) +
  annotation_scale(location = "bl",
                   style = "ticks") +
  coord_sf(crs = 3857,
           datum = NA) +
  theme_minimal() +
  theme(panel.border = element_rect(linewidth = .2, fill = NA))

Marginalia, cont’d

📎 Giving your marginalia a little breathing room can be a good move. So expand your limits within coord_sf()!

sea <- places("wa",
              cb = TRUE) %>%
  filter(NAME == "Seattle") %>%
  st_transform(3857) %>%
  erase_water(area_threshold = .25) 

xlims <- st_buffer(sea, 5000) %>%
  st_bbox() %>%
  .[c(1, 3)]

ylims <- st_buffer(sea, 5000) %>%
  st_bbox() %>%
  .[c(2, 4)]

ggplot() +
  geom_sf(data = sea) +
  ggspatial::annotation_north_arrow(location = "br",
                         which_north = "true",
                         style = north_arrow_minimal) +
  annotation_scale(location = "bl",
                   style = "ticks") +
  coord_sf(crs = 3857,
           datum = NA,
           xlim = xlims,
           ylim = ylims) +
  theme_minimal() +
  theme(panel.border = element_rect(linewidth = .2, fill = NA))

Basemaps

📎 Kyle Walker’s {mapboxapi} + {ggspatial} = fast, easy basemaps to add context to your map

basemap <- get_static_tiles(
  location = st_buffer(sea, 5000),
  zoom = 10,
  buffer_dist = 0,
  scaling_factor = "2x",
  crop = TRUE,
  style_id = basic_id,
  username = me
)

ggplot() +
  layer_spatial(data = basemap) +
  geom_sf(data = sea,
          fill = NA,
          color = "peru",
          linewidth = 1.5) +
  coord_sf(crs = 3857,
           datum = NA,
           xlim = xlims,
           ylim = ylims) +
  theme_minimal()

Basemaps, cont’d

📎 Try breaking your basemap into two layers: one for the labels and one for the map itself, using Mapbox studio (or other resource), and then layer them with multiple calls to layer_spatial()

tract_pop <- get_acs("tract",
                     state = "WA",
                     county = "King",
                     variables = "B01001_001",
                     geometry = TRUE) %>%
  st_transform(st_crs(sea)) %>%
  st_intersection(sea)

basemap <- get_static_tiles(
  location = sea,
  zoom = 11,
  buffer_dist = 1000,
  scaling_factor = "2x",
  crop = TRUE,
  style_id = basemap_id,
  username = me
)

labels <- get_static_tiles(
  location = sea,
  zoom = 11,
  buffer_dist = 1000,
  scaling_factor = "2x",
  crop = TRUE,
  style_id = labels_id,
  username = me
)

ggplot() +
  layer_spatial(data = basemap) +
  geom_sf(data = tract_pop,
          aes(fill = estimate),
          color = "gray20",
          linewidth = .15,
          alpha = .7) +
  layer_spatial(data = labels) +
  scale_fill_viridis_b(option = "A",
                       direction = 1,
                       name = "Population",
                       n.breaks = 7,
                       labels = comma) +
  coord_sf(crs = 3857,
           datum = NA) +
  theme_minimal() +
  theme(plot.background = element_rect(fill = "white", color = "gray20", linewidth = .2))

Legends

📎 Positioning your legend inside the map can be a good move, especially if you have a lot of white space you’d prefer not to deal with

ggplot() +
  layer_spatial(data = basemap) +
  geom_sf(data = tract_pop,
          aes(fill = estimate),
          color = "gray20",
          linewidth = .15,
          alpha = .7) +
  layer_spatial(data = labels) +
  scale_fill_viridis_b(option = "A",
                       direction = 1,
                       name = "Population",
                       n.breaks = 7,
                       labels = comma) +
  coord_sf(crs = 3857,
           datum = NA,
           # This one is necessary!
           expand = 0) +
  theme_minimal() +
  theme(legend.position = "inside",
        legend.location = "plot",
        legend.position.inside = c(0, 0),
        legend.justification.inside = c(0, 0),
        # element_rect() doesn't have an alpha argument, but you can trick it with HEX
        legend.box.background = element_rect(fill = "#ffffff60", color = NA)) +
  theme(plot.background = element_rect(fill = "white", color = "gray20", linewidth = .2))

Insets

📎 You can use {patchwork} to compose a simple inset map composition. Here you’re really just arranging two separate plots.

greenlake <- st_as_sfc("POLYGON ((-13620987 6050695, -13620987 6056227, -13615566 6056227, -13615566 6050695, -13620987 6050695))", crs = 3857) %>%
  st_sf()

xlims <- st_bbox(greenlake)[c(1, 3)]

ylims <- st_bbox(greenlake)[c(2, 4)]

basemap <- get_static_tiles(
  location = greenlake,
  zoom = 13,
  buffer_dist = 1000,
  scaling_factor = "2x",
  crop = TRUE,
  style_id = basemap_id,
  username = me
)

labels <- get_static_tiles(
  location = greenlake,
  zoom = 13,
  buffer_dist = 1000,
  scaling_factor = "2x",
  crop = TRUE,
  style_id = labels_id,
  username = me
)

inset <- ggplot() +
  geom_sf(data = sea,
          fill = "white",
          color = "gray20",
          linewidth = .25) +
  geom_sf(data = greenlake,
          fill = NA,
          color = "tomato",
          linewidth = 1.25) +
  theme_void() +
  coord_sf(datum = NA) +
  theme(plot.background = element_rect(fill = "#ffffff60", color = NA))

ggplot() +
  layer_spatial(data = basemap) +
  geom_sf(data = tract_pop,
          aes(fill = estimate),
          color = "gray20",
          linewidth = .15,
          alpha = .7) +
  layer_spatial(data = labels) +
  scale_fill_viridis_b(option = "A",
                       direction = 1,
                       name = "Population",
                       n.breaks = 7,
                       labels = comma) +
  coord_sf(crs = 3857,
           datum = NA,
           # This one is necessary!
           expand = 0,
           xlim = xlims,
           ylim = ylims) +
  theme_minimal() +
  theme(legend.position = "inside",
        legend.location = "plot",
        legend.position.inside = c(0, 0),
        legend.justification.inside = c(0, 0),
        # element_rect() doesn't have an alpha argument, but you can trick it with HEX
        legend.box.background = element_rect(fill = "#ffffff60", color = NA)) +
  patchwork::inset_element(inset,
                           left = .7,
                           bottom = 0,
                           right = 1,
                           top = .5,
                           align_to = "full")

Insets

📎 Or, {ggmagnify} could let you do a more traditional inset, if that’s what you’re looking for

counties <- counties("wa",
                     cb = TRUE) %>%
  st_transform(3857)

to <- st_as_sfc("POLYGON ((-13881692 6185920, -13881692 6376113, -13774182 6376113, -13774182 6185920, -13881692 6185920))",
                crs = 3857) %>%
  st_sf()

xlims <- st_bbox(st_union(counties, to))[c(1, 3)]

ylims <- st_bbox(st_union(counties, to))[c(2, 4)]

county_map <- ggplot() +
  geom_sf(data = counties,
          fill = "white",
          color = "gray40",
          linewidth = .2) + 
  geom_sf(data = sea,
          fill = NA,
          color = "tomato",
          linewidth = .2) +
  coord_sf(crs = 3857,
           datum = NA,
           # This one is necessary!
           expand = 0,
           xlim = xlims,
           ylim = ylims*c(.9, 1.1)) +
  theme_minimal() 

county_map +
  geom_magnify(data = sea,
               from = as.list(st_bbox(sea)[c(1, 3, 2, 4)]),
               to = as.list(st_bbox(to)[c(1, 3, 2, 4)])) +
  coord_sf(crs = 3857,
           datum = NA,
           # This one is necessary!
           expand = 0,
           xlim = xlims,
           ylim = ylims*c(.99, 1.01))

Labels

📎 {ggrepel} is a very powerful tool for labeling your map, especially when you have a lot of labels to place. It can be a bit fussy though, so it will likely take lots of trial and error. And don’t sleep on the bg.colour argument for geom_text_repel()!

cities <- get_acs("place",
                                    state = "wa",
                                    variables = "B01001_001",
                                    year = 2022,
                                    geometry = TRUE) %>%
    filter(estimate > 7.5e4) %>%
    mutate(NAME = str_remove_all(NAME, paste0(c(" city, Washington", " CDP, Washington"), collapse = "|"))) %>%
    mutate(class = santoku::chop(estimate, breaks = c(1e5, 1.5e5, 2e5))) %>%
  # filter(NAME %in% c("Seattle", "Tacoma", "Olympia", "Spokane", "Walla Walla")) %>%
  st_transform(3857)

ggplot() +
  geom_sf(data = counties,
          fill = "white",
          color = "gray40",
          linewidth = .2) + 
  geom_label_repel(data = st_centroid(cities),
                   aes(x = st_coordinates(geometry)[, 1],
                       y = st_coordinates(geometry)[, 2],
                       label = NAME,
                        size = class),
                   min.segment.length = 0,
                   color = "white",
                   fill = "tomato3",
                   label.r = unit(0, "lines"),
                   label.size = 0,
                   segment.colour = "tomato3",
                   segment.size = .5,
                   nudge_y = 50000) +
  geom_sf(data = st_centroid(cities),
          color = "tomato3",
          fill = "white",
          shape = 21,
          stroke = 1) +
  coord_sf(crs = 3857,
           datum = NA,
           # This one is necessary!
           expand = 0) +
    scale_size_discrete(range = c(6, 6, 8, 12),
                                            guide = "none") +
    
  theme_minimal() +
  labs(x = NULL,
       y = NULL)

Labels, cont’d

📎 Using st_inscribed_circle() can help you find the appropriate centroid for unusual polygons, especially when st_point_on_surface() fails

cities <- places("wa") %>%
  filter(NAME %in% c("Seattle", "Tacoma", "Olympia", "Spokane", "Walla Walla")) %>%
  st_transform(3857)

county_lbls <- st_point_on_surface(counties) %>%
  transmute(name = NAME,
            x = st_coordinates(.)[, 1],
            y = st_coordinates(.)[, 2])

ggplot() +
  geom_sf(data = counties,
          fill = "white",
          color = "gray40",
          linewidth = .2) + 
    geom_text_repel(data = county_lbls,
                    aes(x = x,
                            y = y,
                            label = str_wrap(name, 10)),
                    # ggrepel functions have this bg.colour argument that is a nice touch for readability
                    bg.colour = "white",
                    bg.r = .2,
                    force = 0,
                    color = "gray70",
                    fontface = "bold",
                    size = 3.5) +
  geom_label_repel(data = st_centroid(cities),
                   aes(x = st_coordinates(geometry)[, 1],
                       y = st_coordinates(geometry)[, 2],
                       label = NAME),
                   min.segment.length = 0,
                   color = "white",
                   fill = "tomato3",
                   label.r = unit(0, "lines"),
                   label.size = 0,
                   segment.colour = "tomato3",
                   segment.size = 1,
                   nudge_y = 50000) +
  geom_sf(data = st_centroid(cities),
          color = "tomato3",
          fill = "white",
          shape = 21,
          stroke = 1) +
  coord_sf(crs = 3857,
           datum = NA,
           expand = 0) +
  theme_minimal() +
  labs(x = NULL,
       y = NULL)

Labels, cont’d

📎 Using st_inscribed_circle can help you find the appropriate centroid for unusual polygons, especially when st_point_on_surface fails

circles <- counties %>%
    pull(geometry) %>% 
  st_inscribed_circle() %>%
  st_sf() %>%
  filter(!st_is_empty(geometry))

county_lbls <- circles %>%
  st_centroid() %>% 
  transmute(name = counties$NAME,
                    x = st_coordinates(.)[, 1],
                    y = st_coordinates(.)[, 2])
  
ggplot() +
  geom_sf(data = counties,
          fill = "white",
          color = "gray40",
          linewidth = .2) + 
    geom_sf(data = circles,
                    fill = NA,
                    color = "gray20",
                    linewidth = .25,
                    linetype = "dotted") +
    geom_text_repel(data = county_lbls,
                    aes(x = x,
                            y = y,
                            label = str_wrap(name, 10)),
                    # ggrepel functions have this bg.colour argument that is a nice touch for readability
                    bg.colour = "white",
                    bg.r = .2,
                    force = 0,
                    color = "gray70",
                    fontface = "bold",
                    size = 3.5) +
  geom_label_repel(data = st_centroid(cities),
                   aes(x = st_coordinates(geometry)[, 1],
                       y = st_coordinates(geometry)[, 2],
                       label = NAME),
                   min.segment.length = 0,
                   color = "white",
                   fill = "tomato3",
                   label.r = unit(0, "lines"),
                   label.size = 0,
                   segment.colour = "tomato3",
                   segment.size = 1,
                   nudge_y = 50000) +
  geom_sf(data = st_centroid(cities),
          color = "tomato3",
          fill = "white",
          shape = 21,
          stroke = 1) +
  coord_sf(crs = 3857,
           datum = NA,
           expand = 0) +
  theme_minimal() +
  labs(x = NULL,
       y = NULL)

Labels, cont’d

📎 {ggforce} has a geom_mark_...() family of functions that are nicely styled and can be used to label clusters of points or other geometries

# Read in the data, in this case this CSV from WA DNR https://data-wadnr.opendata.arcgis.com/datasets/dabefcb8f03549b49bee7564d4c3c4b5_2/
fires <- read_csv("/Users/sherrill/Projects/CascadiaR_Cartographic_Tips/01_data/01_raw/DNR_Fire_Statistics_2008_-_Present.csv") %>% 
  st_as_sf(coords = c("LON_COORD", "LAT_COORD"), crs = 4326) %>%
    st_transform(3857) %>%
    transmute(acres_burned = ACRES_BURNED,
                        cause = FIREGCAUSE_LABEL_NM,
                        year = str_sub(DSCVR_DT, 1, 4)) %>%
    st_as_sf() %>%
    filter(year == 2023,
                 acres_burned > 0)
  
fires_ne <- fires %>%
    filter(year == 2023,
                 cause == "Power Gen") %>%
    st_filter(counties %>%
                            filter(NAME %in% c("Pend Oreille", "Spokane", "Stevens"))) %>%
    mutate(x = st_coordinates(geometry)[,1],
                 y = st_coordinates(geometry)[,2])

tot <- sum(fires_ne$acres_burned)

tot_2023 <- sum(fires$acres_burned)

pct <- tot/tot_2023

anchor <- st_centroid(st_union(fires_ne)) %>%
    st_sf() %>%
    mutate(x = st_coordinates(geometry)[,1],
                 y = st_coordinates(geometry)[,2])

ggplot() +
    geom_sf(data = counties,
            fill = "white",
            color = "gray40",
            linewidth = .2) + 
    geom_sf(data = fires,
            aes(size = acres_burned),
            color = "gray50",
            alpha = .3) +
    geom_sf(data = fires_ne,
            aes(size = acres_burned),
            color = "peru",
            alpha = 1) +
    geom_label_repel(data = st_centroid(cities),
                     aes(x = st_coordinates(geometry)[, 1],
                         y = st_coordinates(geometry)[, 2],
                         label = NAME),
                     min.segment.length = 0,
                     color = "white",
                     fill = "tomato3",
                     label.r = unit(0, "lines"),
                     label.size = 0,
                     segment.colour = "tomato3",
                     segment.size = 1,
                     nudge_y = 50000) +
    geom_sf(data = st_centroid(cities),
            color = "tomato3",
            fill = "white",
            shape = 21,
            stroke = 1) +
    geom_mark_ellipse(data = fires_ne,
                      aes(x = x,
                          y = y,
                          label = str_wrap(paste0("Wildfires caused by power generation burned a combined ", comma(tot, accuracy = 1), " acres, ", percent(pct, accuracy = 1), " of all statewide acres in 2023, in Pend Oreille, Spokane, and Stevens counties"), 36)),
                      x0 = anchor$x - 50000,
                      y0 = anchor$y + 50000,
                      label.fill = "#E4EBF1",
                      con.cap = 0, 
                      label.buffer = unit(4, "lines"),
                      label.fontsize = 10,
                      show.legend = FALSE) +
    scale_size_continuous(name = "Acres\nburned",
                          range = c(1, 10),
                                                labels = comma,
                          breaks = c(10, 1000, 5000, 20000, 50000)) +
    coord_sf(crs = 3857,
             datum = NA,
             expand = 0) +
    theme_minimal() +
    labs(x = NULL,
         y = NULL)

Labels, cont’d

📎 {ggfx} has a number of graphical filtering functions. You could pair it with {ggforce} to create a poppy label box with a drop-shadow effect

all_fires <- read_csv("/Users/sherrill/Projects/CascadiaR_Cartographic_Tips/01_data/01_raw/DNR_Fire_Statistics_2008_-_Present.csv") %>% 
  st_as_sf(coords = c("LON_COORD", "LAT_COORD"), crs = 4326) %>%
    st_transform(3857) %>%
    transmute(acres_burned = ACRES_BURNED,
                        cause = FIREGCAUSE_LABEL_NM,
                        year = str_sub(DSCVR_DT, 1, 4)) %>%
    st_as_sf()

fires <- all_fires %>%
    filter(year == 2023,
                 acres_burned > 0)
  
fires_ne <- fires %>%
    filter(year == 2023,
                 cause == "Power Gen") %>%
    st_filter(counties %>%
                            filter(NAME %in% c("Pend Oreille", "Spokane", "Stevens"))) %>%
    mutate(x = st_coordinates(geometry)[,1],
                 y = st_coordinates(geometry)[,2])

tot <- sum(fires_ne$acres_burned)

tot_2023 <- sum(fires$acres_burned)

pct <- tot/tot_2023

anchor <- st_centroid(st_union(fires_ne)) %>%
    st_sf() %>%
    mutate(x = st_coordinates(geometry)[,1],
                 y = st_coordinates(geometry)[,2])

ggplot() +
    geom_sf(
        data = counties,
        fill = "white",
        color = "gray40",
        linewidth = .2
    ) +
    geom_sf(
        data = fires,
        aes(size = acres_burned),
        color = "gray50",
        alpha = .3
    ) +
    geom_sf(
        data = fires_ne,
        aes(size = acres_burned),
        color = "peru",
        alpha = 1
    ) +
    geom_label_repel(
        data = st_centroid(cities),
        aes(
            x = st_coordinates(geometry)[, 1],
            y = st_coordinates(geometry)[, 2],
            label = NAME
        ),
        min.segment.length = 0,
        color = "white",
        fill = "tomato3",
        label.r = unit(0, "lines"),
        label.size = 0,
        segment.colour = "tomato3",
        segment.size = 1,
        nudge_y = 50000
    ) +
    geom_sf(
        data = st_centroid(cities),
        color = "tomato3",
        fill = "white",
        shape = 21,
        stroke = 1
    ) +
    with_shadow(
        geom_mark_ellipse(
            data = fires_ne,
            aes(
                x = x,
                y = y,
                label = str_wrap(
                    paste0(
                        "Wildfires caused by power generation burned a combined ",
                        comma(tot, accuracy = 1),
                        " acres, ",
                        percent(pct, accuracy = 1),
                        " of all statewide acres in 2023, in Pend Oreille, Spokane, and Stevens counties"
                    ),
                    36
                )
            ),
            x0 = anchor$x - 50000,
            y0 = anchor$y + 50000,
            label.fill = "#E4EBF1",
            con.cap = 0,
            label.buffer = unit(4, "lines"),
            label.fontsize = 10,
            show.legend = FALSE
        ),
        colour = "#151F2850",
        sigma = 3
    ) +
    scale_size_continuous(
        name = "Acres\nburned",
        range = c(1, 10),
        labels = comma,
        breaks = c(10, 1000, 5000, 20000, 50000)
    ) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal() +
    labs(x = NULL, y = NULL)

Patterns

📎 {ggdensity} has a geom_hdr() functions that provides a more visually appealing way to show point density, with a fairly easy-to-understand legend. You could even give it a blur with {ggfx} to make it seem more gestural than literal

fires_hdr <- fires %>%
    mutate(x = st_coordinates(geometry)[,1],
                 y = st_coordinates(geometry)[,2]) %>%
    st_drop_geometry() %>%
    filter(cause %in% c("Natural", "Power Gen", "Fireworks")) %>%
    mutate(cause = ordered(cause, 
                                                 levels = c("Natural", "Power Gen", "Fireworks"))) 


ggplot() +
    as_reference(with_blur(
        geom_hdr(
            data = fires_hdr,
            aes(
                x = x,
                y = y,
                group = cause,
                fill = cause
            ),
            probs = c(.33),
            n = 300,
            # Expand the limits to give the geometry some breathing room
            xlim = st_bbox(counties)[c(1, 3)] * c(.9, 1.1),
            ylim = st_bbox(counties)[c(2, 4)] * c(.9, 1.1),
            alpha = .8
        ),
        sigma = unit(.25, "lines")
    ), id = "hdr") +
    # Putting a xor blend on our county borders could help them not get lost behind the HDR
    with_blend(
        geom_sf(
            data = counties,
            fill = "NA",
            color = "gray20",
            linewidth = .2
        ),
        bg_layer = "hdr",
        blend_type = "xor"
    ) +
    geom_label_repel(
        data = st_centroid(cities),
        aes(
            x = st_coordinates(geometry)[, 1],
            y = st_coordinates(geometry)[, 2],
            label = NAME
        ),
        min.segment.length = 0,
        color = "white",
        fill = "tomato3",
        label.r = unit(0, "lines"),
        label.size = 0,
        segment.colour = "tomato3",
        segment.size = 1,
        nudge_y = 50000
    ) +
    geom_sf(
        data = st_centroid(cities),
        color = "tomato3",
        fill = "white",
        shape = 21,
        stroke = 1
    ) +
    scale_fill_manual(name = "Cause",
                                        values = c("deepskyblue4", "deeppink4", "peru")) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top",
                legend.justification.top = "left") +
    labs(x = NULL, y = NULL)

Patterns

📎 Then again, sometimes using a grid is an effective way of showing spatial patterns, and you can add an extra visual variable by using points that match your grid and varying their size

wa_grid <- st_make_grid(counties,
                                                cellsize = 20000) %>%
    st_sf() %>%
    rowid_to_column("gridid")

fire_grid <- st_join(wa_grid, all_fires %>%
                                            filter(acres_burned > 0,
                                                         cause %in% c("Power Gen", "Fireworks", "Natural"))) %>%
    group_by(gridid, cause) %>%
    summarise(acres_burned = sum(acres_burned)) %>%
    group_by(gridid) %>%
    filter(acres_burned == max(acres_burned, na.rm = TRUE)) %>%
    ungroup() %>%
    mutate(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
    st_centroid() %>%
    mutate(cause = ordered(cause, 
                                                 levels = c("Natural", "Power Gen", "Fireworks"))) 

ggplot() +
    geom_sf(
        data = counties,
        fill = "white",
        color = "gray40",
        linewidth = .2
    ) +
    geom_sf(data = fire_grid,
                    aes(color = cause, size = acres_burned),
                    shape = 15) +
    geom_label_repel(
        data = st_centroid(cities),
        aes(
            x = st_coordinates(geometry)[, 1],
            y = st_coordinates(geometry)[, 2],
            label = NAME
        ),
        min.segment.length = 0,
        color = "white",
        fill = "tomato3",
        label.r = unit(0, "lines"),
        label.size = 0,
        segment.colour = "tomato3",
        segment.size = 1,
        nudge_y = 50000
    ) +
    geom_sf(
        data = st_centroid(cities),
        color = "tomato3",
        fill = "white",
        shape = 21,
        stroke = 1
    ) +
    scale_size_binned(
        name = "Acres\nburned",
        labels = comma,
        range = c(2, 5),
        breaks = c(10, 25000),
        guide = guide_bins(keywidth = unit(2, "lines"))
    ) +
    scale_color_manual(name = "Cause",
                                         values = c("deepskyblue4", "deeppink4", "peru")) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top",
                legend.justification.top = "left") +
    labs(
        x = NULL, 
        y = NULL
        )

Patterns

📎 Though you might want to make your other layers conform to this grid, too.

wa_grid <- st_make_grid(counties,
                                                cellsize = 20000) %>%
    st_sf() %>%
    rowid_to_column("gridid")

county_grid <- wa_grid %>%
    st_join(counties, largest = TRUE, left = FALSE) %>%
    group_by(county = NAME) %>%
    summarise()

county_grid_lbls <- county_grid %>%
    pull(geometry) %>% 
  st_inscribed_circle() %>%
  st_sf() %>%
  filter(!st_is_empty(geometry)) %>% 
  st_centroid() %>% 
  transmute(name = county_grid$county,
                    x = st_coordinates(.)[, 1],
                    y = st_coordinates(.)[, 2])

fire_grid <- st_join(wa_grid, all_fires %>%
                                            filter(acres_burned > 0,
                                                         cause %in% c("Power Gen", "Fireworks", "Natural"))) %>%
    group_by(gridid, cause) %>%
    summarise(acres_burned = sum(acres_burned)) %>%
    group_by(gridid) %>%
    filter(acres_burned == max(acres_burned, na.rm = TRUE)) %>%
    ungroup() %>%
    mutate(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
    st_centroid() %>%
    mutate(cause = ordered(cause, 
                                                 levels = c("Natural", "Power Gen", "Fireworks"))) 

ggplot() +
    geom_sf(
        data = county_grid,
        fill = "white",
        color = "gray40",
        linewidth = .33
    ) +
    geom_sf(data = fire_grid,
                    aes(color = cause,
                            size = acres_burned),
                    shape = 15) +
    geom_label(data = county_lbls,
                    aes(x = x,
                            y = y,
                            label = str_wrap(name, 4)),
                    fill = "gray90",
                    alpha = .7,
                    color = "gray20",
                    fontface = "bold",
                    label.r = unit(0, "lines"),
                    label.size = 0,
                    size = 3.5) +
 scale_size_binned(name = "Acres\nburned",
                                                labels = comma,
                                    range = c(2, 5),
                          breaks = c(10, 25000),
                                    guide = guide_bins(keywidth = unit(2, "lines"))) +
    scale_color_manual(name = "Cause",
                                        values = c("deepskyblue4", "deeppink4", "peru")) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top",
                legend.justification.top = "left") +
    labs(x = NULL, y = NULL)

Simplification

📎 While we’re modifying geometries, {rmapshaper} is a great package for simplifying geometries, which can be especially useful for rendering large spatial datasets

counties_simp <- ms_simplify(counties, keep = .02, keep_shapes = TRUE) 

counties_simp_lbls <- counties_simp %>%
    pull(geometry) %>% 
  st_inscribed_circle() %>%
  st_sf() %>%
  filter(!st_is_empty(geometry)) %>% 
  st_centroid() %>% 
  transmute(name = counties_simp$NAME,
                    x = st_coordinates(.)[, 1],
                    y = st_coordinates(.)[, 2])

ggplot() +
    geom_sf(
        data = counties_simp,
        fill = "white",
        color = "gray40",
        linewidth = .2
    ) +
    geom_sf(data = fire_grid,
                    aes(color = cause, size = acres_burned),
                    shape = 15) +
    geom_label(
        data = counties_simp_lbls,
        aes(
            x = x,
            y = y,
            label = str_wrap(name, 4)
        ),
        fill = "gray90",
        alpha = .7,
        color = "gray20",
        fontface = "bold",
        label.r = unit(0, "lines"),
        label.size = 0,
        size = 3.5
    ) +
    scale_size_binned(
        name = "Acres\nburned",
        labels = comma,
        range = c(2, 5),
        breaks = c(10, 25000),
        guide = guide_bins(keywidth = unit(2, "lines"))
    ) +
    scale_color_manual(name = "Cause",
                                         values = c("deepskyblue4", "deeppink4", "peru")) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top",
                legend.justification.top = "left") +
    labs(x = NULL, y = NULL)

Simplification

📎 {smoothr} can also be used to add rounded corners to your polygons or line geometries for a more stylized look

counties_simp <- counties %>%
    ms_simplify(keep = .02, keep_shapes = TRUE) %>%
    smooth(method = "ksmooth",
                 smoothness = .35) %>%
    # Sometimes you can create geometry errors when smoothing, so it's good to check and fix these with a call to st_make_valid()
    st_make_valid()

counties_simp_lbls <- counties_simp %>%
    pull(geometry) %>% 
  st_inscribed_circle() %>%
  st_sf() %>%
  filter(!st_is_empty(geometry)) %>% 
  st_centroid() %>% 
  transmute(name = counties_simp$NAME,
                    x = st_coordinates(.)[, 1],
                    y = st_coordinates(.)[, 2])

ggplot() +
    geom_sf(
        data = counties_simp,
        fill = "white",
        color = "gray40",
        linewidth = .2
    ) +
    geom_sf(data = fire_grid,
                    aes(color = cause, size = acres_burned),
                    shape = 16) +
    geom_label(
        data = counties_simp_lbls,
        aes(
            x = x,
            y = y,
            label = str_wrap(name, 4)
        ),
        fill = "gray90",
        alpha = .7,
        color = "gray20",
        fontface = "bold",
        label.r = unit(0, "lines"),
        label.size = 0,
        size = 3.5
    ) +
    scale_size_binned(
        name = "Acres\nburned",
        labels = comma,
        range = c(2, 5),
        breaks = c(10, 25000),
        guide = guide_bins(keywidth = unit(2, "lines"))
    ) +
    scale_color_manual(name = "Cause",
                                         values = c("deepskyblue4", "deeppink4", "peru")) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top",
                legend.justification.top = "left") +
    labs(x = NULL, y = NULL)

Simplification

📎 Did you know you can use negative values for st_buffer()?

counties_simp <- counties %>%
    st_buffer(-2000) %>%
    ms_simplify(keep = .02, keep_shapes = TRUE) %>%
    smooth(method = "ksmooth", smoothness = .35) %>%
    # Sometimes you can create geometry errors when smoothing, so it's good to check and fix these with a call to st_make_valid()
    st_make_valid()

counties_simp_lbls <- counties_simp %>%
    pull(geometry) %>% 
  st_inscribed_circle() %>%
  st_sf() %>%
  filter(!st_is_empty(geometry)) %>% 
  st_centroid() %>% 
  transmute(name = counties_simp$NAME,
                    x = st_coordinates(.)[, 1],
                    y = st_coordinates(.)[, 2])

ggplot() +
    geom_sf(
        data = counties_simp,
        fill = "white",
        color = "gray20",
        linewidth = .2
    ) +
    geom_sf(
        data = fire_grid %>%
            st_filter(counties_simp),
        aes(color = cause, size = acres_burned),
        shape = 16
    ) +
    geom_label(
        data = counties_simp_lbls,
        aes(
            x = x,
            y = y,
            label = str_wrap(name, 4)
        ),
        fill = "gray90",
        alpha = .7,
        color = "gray20",
        fontface = "bold",
        label.r = unit(0, "lines"),
        label.size = 0,
        size = 3.5
    ) +
    scale_size_binned(
        name = "Acres\nburned",
        labels = comma,
        range = c(2, 5),
        breaks = c(10, 25000),
        guide = guide_bins(keywidth = unit(2, "lines"))
    ) +
    scale_color_manual(name = "Cause",
                                         values = c("deepskyblue4", "deeppink4", "peru")) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top",
                legend.justification.top = "left") +
    labs(x = NULL, y = NULL)

Symbols - Lines

📎 Brand new package {ggarrow} offers a completely new way of visualizing flowlines from point to point with arrows that aren’t the lackluster defaults from {ggplot2}. Lots of customizability!

lines <- st_as_sfc(c("LINESTRING (-122.3207 47.52453, -122.418 47.23233)", "LINESTRING (-122.3298 47.56603, -122.8504 47.03125)", 
"LINESTRING (-122.2829 47.54782, -122.5151 45.6868)", "LINESTRING (-122.1708 47.5856, -117.4509 47.67072)", 
"LINESTRING (-122.2388 47.55275, -119.3356 46.312)", "LINESTRING (-122.3922 45.71895, -119.4382 46.20556)", 
"LINESTRING (-117.3921 47.49202, -119.2271 46.29595)"),
crs = 4326) %>%
    st_transform(3857) %>%
    st_sf() %>%
    rowid_to_column("lineid") %>%
    st_cast("POINT") %>%
    mutate(x = st_coordinates(.)[,1],
                 y = st_coordinates(.)[,2]) %>%
    st_drop_geometry() %>%
    group_by(lineid) %>%
    mutate(pt = 1:2) %>%
    pivot_wider(names_from = pt,
                            values_from = c(x, y))

ggplot() +
    geom_sf(
        data = counties_simp,
        fill = "white",
        color = "gray40",
        linewidth = .2
    ) +
    geom_arrow_curve(
        data = lines,
        aes(
            x = x_1,
            y = y_1,
            xend = x_2,
            yend = y_2,
            group = lineid
        ),
        color = "deepskyblue4",
        curvature = .2,
        arrow_head = arrow_head_wings(offset = 50),
        length = 2,
        length_head = 1,
        linewidth_head = 6,
        linewidth_fins = 0,
        alpha = .3
    ) +
    scale_size_binned(
        name = "Acres\nburned",
        labels = comma,
        range = c(2, 5),
        breaks = c(10, 25000),
        guide = guide_bins(keywidth = unit(2, "lines"))
    ) +
    scale_color_manual(name = "Cause",
                                         values = c("deepskyblue4", "deeppink4", "peru")) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "top",
                legend.justification.top = "left") +
    labs(x = NULL, y = NULL)

Symbols - Points

📎 {ggstar} doesn’t get enough love! It’s a great way to show point data with a little more flair than the standard {ggplot2} PCH shapes

star_fire_grid <- st_join(wa_grid, all_fires %>%
                                            filter(acres_burned > 0,
                                                         year >= 2003,
                                                         cause %in% c("Power Gen", "Fireworks", "Natural"),
                                                         !is.na(cause)),
                                            left = FALSE) %>%
    st_drop_geometry() %>%
    group_by(gridid, year, cause) %>%
    summarise(acres_burned = sum(acres_burned)) %>%
    ungroup() %>%
    complete(year, cause, nesting(gridid), fill = list(acres_burned = 0)) %>%
    filter(!is.na(cause)) %>%
    group_by(gridid, cause) %>%
    mutate(cause_acres = sum(acres_burned)) %>%
    group_by(gridid) %>% 
    mutate(main_cause = first(cause[which(cause_acres == max(cause_acres))])) %>%
    group_by(gridid, main_cause, year) %>%
    summarise(acres_burned = ifelse(is.na(acres_burned), 0, acres_burned)) %>%
    group_by(gridid, main_cause) %>%
    summarise(year = weighted.mean(as.numeric(year), w = acres_burned, na.rm = TRUE),
                        acres_burned = sum(acres_burned)) %>%
    ungroup() %>%
    inner_join(wa_grid) %>%
    st_as_sf() %>%
    st_centroid() %>%
    mutate(main_cause = ordered(main_cause, 
                                                 levels = c("Natural", "Power Gen", "Fireworks")),
                 x = st_coordinates(.)[, 1],
                 y = st_coordinates(.)[, 2]) %>%
    st_drop_geometry()

ggplot() +
    geom_sf(
        data = county_grid,
        fill = "white",
        color = "gray40",
        linewidth = .2
    ) +
    geom_star(
        data = star_fire_grid,
        aes(
            fill = year,
            size = acres_burned,
            starshape = main_cause,
            x = x,
            y = y
        ),
        starstroke = .1
    ) +
    geom_label(
        data = county_lbls,
        aes(
            x = x,
            y = y,
            label = str_wrap(name, 4)
        ),
        fill = "gray90",
        alpha = .7,
        color = "gray20",
        fontface = "bold",
        label.r = unit(0, "lines"),
        label.size = 0,
        size = 3.5
    ) +
    scale_size_binned(
        name = "Acres\nburned",
        labels = comma,
        range = c(2, 5),
        breaks = c(10, 25000),
        guide = guide_bins(keywidth = unit(2, "lines"),
                                             override.aes = list(starshape = 3))
    ) +
    scale_starshape_manual(
        name = "Cause",
        values = c(
            "Natural" = 28,
            "Power Gen" = 30,
            "Fireworks" = 3
        ),
        guide = guide_legend(override.aes = list(size = 5))) +
    scale_fill_distiller(name = "Wtd. Avg. Year",
                                             palette = "Oranges",
                                             direction = 1) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal(base_size = 12) +
    theme(legend.position = "right") +
    labs(x = NULL, y = NULL)

Symbols - Points

📎 {ggsvg} give you the ability to use SVGs as points in your plots, even our old pal Clippy!

# Read in a downloaded static SVG
svg_text <- paste(readLines("./01_data/01_raw/clippy.svg"), collapse = "\n")

ggplot() +
    geom_sf(
        data = counties,
        fill = "white",
        color = "gray40",
        linewidth = .2
    ) +
    geom_point_svg(
        data = clippy[1,],
        aes(x = x, y = y),
        size = 5,
        svg = svg_text,
        svg_width = 600,
        svg_height = 800,
        defaults = list(fill_inner = 'white', fill_outer = 'red')
    ) +
    geom_label_repel(
        data = clippy[1,],
        aes(
            x = x,
            y = y,
            label = str_wrap(lines, 24)
        ),
        size = 5,
        hjust = 0,
        nudge_x = 50000,
        nudge_y = 50000,
        min.segment.length = 0,
        point.padding = unit(2, "lines")
    ) +
    scale_size_continuous(
        name = "Acres\nburned",
        range = c(1, 10),
        labels = comma,
        breaks = c(1, 5, 50, 100, 1000)
    ) +
    coord_sf(crs = 3857,
                     datum = NA,
                     expand = 0) +
    theme_minimal() +
    labs(x = NULL, y = NULL)

Thank You, Creators

@hadley, @thomasp85 {gg______}, @edzer {sf}, @clauswilke {ggplot2 and others}, @paleolimbot {ggspatial}, @ateucher {rmapshaper}, @coolbutuseless {ggsvg}, @slokow {ggrepel}, @walkerke {tidycensus}, @jamesotto852 {ggdensity}, @xiangpin {ggstar}, @hughjonesd {ggmagnify}, @mstrimas {smoothr}

and many more!